Deutsche Edition 1/Deutsche Edition 1.iso/amok/021-030/amok22/lists/lists.mod

Text File | 1993-11-04 | 8KB | 339 lines

(**********************************************************************

    :Program.    Lists.mod
    :Contents.   Generic data type: List
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      [phone]
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga AMSoft 3.2d
    :Imports.    TaskMemory [bne]
    :History.    V1.0 [mif] 13.Sep.1988
    :History.    V1.1 [bne] 8.Feb.1989 (V1.0 modified)
    :History.    V2.0d [bne] 25.Feb.1989 (complete new version)
    :History.    V2.1a [bne] 22.Mar.1989 (Bug in CreateList() fixed)

**********************************************************************)

IMPLEMENTATION MODULE Lists;

FROM SYSTEM     IMPORT BYTE,ADR,ADDRESS;
FROM Exec       IMPORT MinList,ListPtr,MinNode,NodePtr,AddTail,RemHead,
                Insert,Remove,CopyMem;
FROM TaskMemory IMPORT Allocate,Deallocate;

TYPE    List=POINTER TO Root;
        Root=RECORD
          header:MinList;
          numEntries:CARDINAL;
          listOk:BOOLEAN;
        END;

PROCEDURE CreateList(VAR list:List):BOOLEAN;
BEGIN
  ListsAllocProc(list,SIZE(Root));
  IF list#NIL THEN
    WITH list^ DO
      WITH header DO    (* NewList() macro *)
        head:=ADR(tail);
        tail:=NIL;
        tailPred:=ADR(head);
      END;
      numEntries:=0;
      listOk:=TRUE;
    END;
    RETURN TRUE;
  ELSE
    RETURN FALSE;
  END;
END CreateList;

PROCEDURE AppendEntry(list:List;
                      DataSize:CARDINAL;
                      DataAddr:ADDRESS);
VAR     NewEntry:EntryPtr;
BEGIN
  ListsAllocProc(NewEntry,SIZE(Entry));
  IF NewEntry#NIL THEN
    WITH NewEntry^ DO
      dataPtr:=DataAddr;
      dataSize:=DataSize;
    END;
    AddTail(ADDRESS(list),NewEntry);
    INC(list^.numEntries);
  ELSE
    list^.listOk:=FALSE;
  END;
END AppendEntry;

PROCEDURE AppendEntryC(list:List;
                   VAR Data:ARRAY OF BYTE);
VAR     DataAddr:ADDRESS;
        DataSize:CARDINAL;
BEGIN
  DataSize:=HIGH(Data)+1;
  IF list^.listOk THEN
    ListsAllocProc(DataAddr,DataSize);
    IF DataAddr#NIL THEN
      CopyMem(ADR(Data),DataAddr,DataSize);
      AppendEntry(list,DataSize,DataAddr);
      IF list^.listOk THEN
        RETURN
      ELSE
        ListsDeallocProc(DataAddr);
      END;
    ELSE
      list^.listOk:=FALSE;
    END;
  END;
END AppendEntryC;


PROCEDURE RemoveEntry(list:List;
                  VAR entry:EntryPtr);
BEGIN
  IF entry#NIL THEN (* one of the most exciting *)
    Remove(entry);  (* system crashes: Remove(NIL) *)
    DEC(list^.numEntries);
    ListsDeallocProc(entry);
    entry:=NIL; (* if we used Heap or TaskMemory or MemSystem,
                   this wouldn't be necessary *)
  ELSE
    list^.listOk:=FALSE;
  END;
END RemoveEntry;

PROCEDURE DeleteEntry(list:List;
                      entry:EntryPtr);
BEGIN
  IF entry#NIL THEN
    ListsDeallocProc(entry^.dataPtr);
    RemoveEntry(list,entry);
  END;
END DeleteEntry;

PROCEDURE DeleteList(VAR list:List);
BEGIN
  WITH list^.header DO
    WHILE head^.succ#NIL DO
      DeleteEntry(list,ADDRESS(head));
    END;
  END;
END DeleteList;

PROCEDURE InsertEntry(list:List;
                      Position:EntryPtr;
                      DataSize:CARDINAL;
                      DataAddr:ADDRESS);
VAR     NewEntry:EntryPtr;
BEGIN
  ListsAllocProc(NewEntry,SIZE(Entry));
  IF NewEntry#NIL THEN
    WITH NewEntry^ DO
      dataPtr:=DataAddr;
      dataSize:=DataSize;
    END;
    Insert(ADDRESS(list),NewEntry,Position^.node.pred);
    INC(list^.numEntries);
  ELSE
    list^.listOk:=FALSE;
  END;
END InsertEntry;

PROCEDURE InsertEntryC(list:List;
                       Position:EntryPtr;
                   VAR Data:ARRAY OF BYTE);
VAR     DataAddr:ADDRESS;
        DataSize:CARDINAL;
BEGIN
  IF list^.listOk THEN
    DataSize:=HIGH(Data)+1;
    ListsAllocProc(DataAddr,DataSize);
    IF DataAddr#NIL THEN
      CopyMem(ADR(Data),DataAddr,DataSize);
      InsertEntry(list,Position,DataSize,DataAddr);
      IF list^.listOk THEN
        RETURN
      ELSE
        ListsDeallocProc(DataAddr);
      END;
    ELSE
      list^.listOk:=FALSE;
    END;
  END;
END InsertEntryC;

PROCEDURE ListOk(list:List):BOOLEAN;
VAR     oldOk:BOOLEAN;
BEGIN
  WITH list^ DO
    oldOk:=listOk;
    listOk:=TRUE;
  END;
  RETURN oldOk;
END ListOk;

PROCEDURE EntriesInList(list:List):CARDINAL;
BEGIN
  RETURN list^.numEntries;
END EntriesInList;

PROCEDURE ReadEntry(list:List;
                    entry:EntryPtr;
                VAR DataSize:CARDINAL;
                VAR DataAddr:ADDRESS);
BEGIN
  IF entry#NIL THEN
    WITH entry^ DO
      DataSize:=dataSize;
      DataAddr:=dataPtr;
    END;
  ELSE
    DataSize:=0;
    DataAddr:=NIL;
    list^.listOk:=FALSE;
  END;
END ReadEntry;

PROCEDURE ReadEntryC(list:List;
                     entry:EntryPtr;
                 VAR Data:ARRAY OF BYTE);
VAR     DataAddr:ADDRESS;
        DataSize:CARDINAL;
BEGIN
  ReadEntry(list,entry,DataSize,DataAddr);
  IF CARDINAL(HIGH(Data))>=DataSize THEN
    Data[DataSize]:=0;
  ELSE
    DataSize:=HIGH(Data)+1;
  END;
  CopyMem(DataAddr,ADR(Data),DataSize);
END ReadEntryC;

PROCEDURE ReplaceEntry(list:List;
                       entry:EntryPtr;
                       DataSize:CARDINAL;
                       DataAddr:ADDRESS);
BEGIN
  IF entry#NIL THEN
    WITH entry^ DO
      dataSize:=DataSize;
      dataPtr:=DataAddr;
    END;
  ELSE
    list^.listOk:=FALSE;
  END;
END ReplaceEntry;

PROCEDURE ReplaceEntryC(list:List;
                        entry:EntryPtr;
                    VAR Data:ARRAY OF BYTE);
VAR     NewSize:LONGINT;
        EndAddr:ADDRESS;
BEGIN
  IF entry#NIL THEN
    NewSize:=HIGH(Data)+1;
    WITH entry^ DO
      IF LONGINT(dataSize)<=NewSize THEN
        CopyMem(ADR(Data),dataPtr,dataSize);
      ELSE
        CopyMem(ADR(Data),dataPtr,NewSize);
        EndAddr:=LONGINT(dataPtr)+NewSize;
        EndAddr^:=0;
      END;
    END;
  ELSE
    list^.listOk:=FALSE;
  END;
END ReplaceEntryC;

PROCEDURE LocateEntryAbs(list:List;
                         Position:CARDINAL):EntryPtr;
VAR     entry:EntryPtr;
BEGIN
  IF Position<list^.numEntries THEN
    entry:=ADDRESS(list^.header.head);
    WHILE Position>0 DO
      entry:=ADDRESS(entry^.node.succ);
      DEC(Position);
    END;
    RETURN entry;
  ELSE
    list^.listOk:=FALSE;
    RETURN NIL;
  END;
END LocateEntryAbs;

PROCEDURE LocateEntryRel(list:List;
                     VAR entry:EntryPtr;
                         Offset:INTEGER):BOOLEAN;
VAR     Ok:BOOLEAN;
        OldPos:EntryPtr;
BEGIN
  OldPos:=entry;
  IF Offset>0 THEN
    REPEAT
      DEC(Offset);
    UNTIL NOT Successor(entry) OR (Offset=0);
    IF entry^.node.succ#NIL THEN
      RETURN TRUE;
    ELSE
      entry:=OldPos;
      RETURN FALSE;
    END;
  ELSIF Offset<0 THEN
    REPEAT
      INC(Offset);
    UNTIL NOT Predecessor(entry) OR (Offset=0);
    IF entry^.node.pred#NIL THEN
      RETURN TRUE;
    ELSE
      entry:=OldPos;
      RETURN FALSE;
    END;
  END;
END LocateEntryRel;

PROCEDURE Successor(VAR entry:EntryPtr):BOOLEAN;
BEGIN
  entry:=ADDRESS(entry^.node.succ);
  RETURN entry^.node.succ#NIL;
END Successor;

PROCEDURE Predecessor(VAR entry:EntryPtr):BOOLEAN;
BEGIN
  entry:=ADDRESS(entry^.node.pred);
  RETURN entry^.node.pred#NIL;
END Predecessor;

PROCEDURE FirstEntry(list:List):EntryPtr;
BEGIN
  WITH list^ DO
    IF header.head^.succ#NIL THEN
      RETURN ADDRESS(header.head);
    ELSE
      list^.listOk:=FALSE;
      RETURN NIL;
    END;
  END;
END FirstEntry;

PROCEDURE LastEntry(list:List):EntryPtr;
BEGIN
  WITH list^ DO
    IF header.tailPred^.pred#NIL THEN
      RETURN ADDRESS(header.tailPred);
    ELSE
      list^.listOk:=FALSE;
      RETURN NIL;
    END;
  END;
END LastEntry;

BEGIN
  ListsAllocProc:=Allocate;    (* default allocation procedure *)
  ListsDeallocProc:=Deallocate;
END Lists.